home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / halley.arc / HALLEYS.BAS (.txt) next >
Encoding:
GW-BASIC  |  1985-10-11  |  4.0 KB  |  149 lines

  1. 1  'HALLEYS.BAS:  Original program by Harold Schenk and John Port.  Version 3.6
  2. 2  'by John J. Anderson (c) 1985 Creative Computing Magazine.
  3. 3  '
  4. 10  CLS:PRINT "Daylight or Standard Time (D/S) ";:INPUT T$:PRINT
  5. 15  IF T$="D" OR T$="d" THEN T5=13:T$=" Daylight":GOTO 30
  6. 20  IF T$="S" OR T$="s" THEN T5=12:T$=" Standard":GOTO 30
  7. 25  GOTO 10
  8. 30  PRINT"Month ---------(1-12)";:INPUT M:IF M<1 OR M>12 THEN GOTO 30
  9. 40  PRINT"Day -----------(1-31)";:INPUT D:IF D<1 OR D>31 THEN GOTO 40
  10. 50  PRINT"Year ---(in entirety)";:INPUT Y:IF Y<0 THEN GOTO 50
  11. 60  READ A,E,P,I,N,L,F1,F2,M1,M2,M3,P$
  12. 70  DATA 17.9435,.967267,27762.4,2.8316,1.014827,2.96725,725412,.144
  13. 80  DATA 4.6,14,5,"COMET HALLEY",1,.01672,365.2564,0,0,721356,.5385
  14. 90  M0=M:Y0=Y:D0=D
  15. 110  IF M>2 THEN 130
  16. 120  F=365*Y+INT(D)+31*(M-1)+INT((Y-1)/4)-INT(3/4*INT((Y-1)/100+1)):GOTO 140
  17. 130  F=365*Y+INT(D)+31*(M-1)-INT(0.4*M+2.3)+INT(Y/4)-INT(3/4*INT(Y/100+1))
  18. 140  D$="Saturday Sunday   Monday   Tuesday  WednesdayThursday Friday   "
  19. 150  W$=MID$(D$,9*(F-INT(F/7)*7)+1,9):CLS
  20. 170  PRINT P$:PRINT "-------------------------------------"
  21. 180  PRINT W$;" ";M0;"/";INT(D0);"/";Y0; " ";(D0-INT(D0))*24;"HRS (U.T.)":PRINT
  22. 190  F0=F:D0=D0-INT(D0)
  23. 200  IF F0>725411 THEN M2=5.5
  24. 210  GOSUB 910
  25. 220  GOSUB 1130
  26. 230  X2=X:Y2=Y:Z2=Z
  27. 240  GOSUB 1350
  28. 250  PRINT"Distance from Sun: ";R/1000;" AU"
  29. 260  M9=M1+M2*LOG(R/1000)/LOG(10)
  30. 280  READ A,E,P,I,N,F1,F2
  31. 290  L=1.79065+0.000243999*(Y0+(M0-1)/12-1980)
  32. 300  GOSUB 910
  33. 310  GOSUB 1130
  34. 320  X1=X:Y1=Y:Z1=Z
  35. 330  GOSUB 1350
  36. 340  X3=X2-X1:Y3=Y2-Y1:Z3=Z2-Z1
  37. 350  R=SQR(X3*X3+Y3*Y3+Z3*Z3)*1000
  38. 360  GOSUB 1350
  39. 370  PRINT"Distance from Earth: ";R/1000;" AU":PRINT
  40. 380  R=10*(M9+M3*LOG(R/1000)/LOG(10)):GOSUB 1350
  41. 390  PRINT "Magnitude: ";R/10:PRINT
  42. 410  Q=1:IF X3<0 THEN Q=-1
  43. 420  U=1.5708-Q*ATN(Y3/X3)
  44. 430  S=Z3/SQR(X3*X3+Y3*Y3+Z3*Z3)
  45. 440  IF ABS(S+1)<9.99E-07 THEN I=-1.5708:GOTO 470
  46. 450  IF ABS(S-1)<9.99E-07 THEN I=1.5708:GOTO 470
  47. 460  I=ATN(S/SQR(1-S*S))
  48. 470  T=1.5708-I:C=0.917465*COS(T)+0.397817*SIN(T)*COS(U)
  49. 480  GOSUB 1400
  50. 490  D1=1.5708-I
  51. 500  C=(COS(T)-0.917465*COS(I))/(0.397817*SIN(I))
  52. 510  GOSUB 1400
  53. 520  R=18+Q*I*24/6.28318:R1=R
  54. 530  GOSUB 1275
  55. 540  PRINT"Right Ascension: ";H;" HRS.";M;" MIN."
  56. 560  H=D1*57.2958
  57. 570  R=(ABS(H)-INT(ABS(H)))*60
  58. 580  GOSUB 1350
  59. 590  M=R:H=INT(H):IF H<0 THEN H=H+1
  60. 600  IF M=60 AND H>=0 THEN H=H+1:M=0
  61. 610  IF M=60 AND H<0 THEN H=H-1:M=0
  62. 620  IF H=0 THEN M=M*SGN(D1)
  63. 630  PRINT"Declination: ";H;" DEG.";M;" MIN.":PRINT
  64. 640  E0=(F0-722894-0.2236+D0)*0.0172028*24/6.28318-0.123333
  65. 650  IF ABS(E0)>=24 THEN E0=E0-SGN(E0)*24
  66. 660  IF ABS(E0)>=24 THEN 650
  67. 670  IF E0<0 THEN E0=E0+24
  68. 680  IF R1>=24 THEN R1=R1-24
  69. 690  T0=T5+R1-E0
  70. 700  IF T0>=24 THEN T0=T0-24
  71. 710  IF T0<0 THEN T0=T0+24
  72. 720  H=(-0.00995-COS(1.5708-D1)*0.656059)/(SIN(1.5708-D1)*0.75471)
  73. 730  IF H<=-1 THEN PRINT"Halley is above horizon all day.":GOTO 1540
  74. 740  IF H>=1 THEN PRINT"Halley is below horizon all day.":GOTO 1540
  75. 750  C=H:GOSUB 1400
  76. 760  H=I/6.28318*24
  77. 770  R=T0-H-0.066666
  78. 780  S=T0+H-0.066666
  79. 790  IF R<0 THEN R=R+24
  80. 800  GOSUB 1275
  81. 810  GOSUB 1480
  82. 820  PRINT"Rises: ";H$;":";M$;" Eastern";T$;" Time"
  83. 830  R=S:IF R<0 THEN R=R+24
  84. 840  IF R>=24 THEN R=R-24
  85. 850  GOSUB 1275
  86. 860  GOSUB 1480
  87. 870  PRINT "Sets: ";H$;":";M$;" Eastern";T$;" Time"
  88. 890  END
  89. 910  A5=3.14159*A*SQR(A*A*(1-E*E))
  90. 920  A0=A5*(F0-F1-F2+D0)/P
  91. 930  IF ABS(A0)>A5 THEN A0=A0-SGN(A0)*A5
  92. 940  IF ABS(A0)>A5 THEN 930
  93. 950  IF A0<0 THEN A0=A0+A5
  94. 960  R=A*A*(1-E*E)*(1-E*E)/2
  95. 970  T=2/((E*E-1)*SQR(1-E*E))
  96. 980  K1=3.14159:K=3.14159
  97. 990  K1=K1/2
  98. 1000  S=E*SIN(K)/((E*E-1)*(1+E*COS(K)))
  99. 1010  U=SQR(1-E*E)*TAN(K/2)/(1+E)
  100. 1020  V=ATN(U)
  101. 1030  IF U<=0 AND K>3.14159 THEN V=V+3.14159
  102. 1040  A1=R*(S-T*V)
  103. 1050  IF K>6.28318 THEN A1=A1+(3.14159*A*SQR(A*A*(1-E*E)))
  104. 1060  IF K1<9.99E-07 THEN 1090
  105. 1070  IF A1<A0 THEN K=K+K1:GOTO 990
  106. 1080  IF A1>A0 THEN K=K-K1:GOTO 990
  107. 1090  IF K=6.28318 THEN K=0
  108. 1100  R0=A*(1-E*E)/(1+E*COS(K))
  109. 1110  RETURN
  110. 1130  A1=L-N+K
  111. 1140  IF A1>6.28318 THEN A1=A1-6.28318
  112. 1150  IF A1>3.14159 THEN A1=A1-6.28318
  113. 1160  Q=1:IF A1<0 THEN Q=-1
  114. 1170  C=SIN(A1)*COS(1.5708-I):IF I>1.5708 THEN Q=-Q
  115. 1180  GOSUB 1400
  116. 1190  A2=I
  117. 1200  C=COS(A1)/SIN(A2)
  118. 1210  GOSUB 1400
  119. 1220  Z=R0*SIN(1.5708-A2)
  120. 1230  Y=R0*COS(1.5708-A2)*SIN(N+Q*I)
  121. 1240  X=R0*COS(1.5708-A2)*COS(N+Q*I)
  122. 1250  R=SQR(X*X+Y*Y+Z*Z)*1000
  123. 1260  RETURN
  124. 1275  R1=R
  125. 1280  H=R:R=(H-INT(H))*600
  126. 1290  GOSUB 1350
  127. 1300  M=R/10
  128. 1310  IF M=60 THEN H=H+1:IF M=60 THEN M=0
  129. 1320  K1=-1:H=INT(H):H=H+K1:IF H>24 THEN H=H-24
  130. 1330  RETURN
  131. 1350  R9=R-INT(R)
  132. 1360  IF R9>=0.5 THEN R=R+1
  133. 1370  R=INT(R)
  134. 1380  RETURN
  135. 1400  IF ABS(C-0)<9.99E-07 THEN I=3.14159/2:RETURN
  136. 1410  IF ABS(C-1)<9.99E-07 THEN I=0:RETURN
  137. 1420  IF ABS(C+1)<9.99E-07 THEN I=3.14159:RETURN
  138. 1430  I=ATN(SQR(1-C*C)/C)
  139. 1440  IF I=0 THEN I=3.14159/2:RETURN
  140. 1450  IF C<0 THEN I=I+3.14159
  141. 1460  RETURN
  142. 1480  R=M:GOSUB 1350
  143. 1490  M=R:IF M=60 THEN H=H+1:IF M=60 THEN M=0
  144. 1500  H$=STR$(H)
  145. 1510  M$=RIGHT$(STR$(M),LEN(STR$(M))-1)
  146. 1520  IF LEN(M$)<2 THEN M$="0"+M$
  147. 1530  RETURN
  148. 1540  END
  149.